//=============================================================================
///	Utility
//=============================================================================

#include "sutil.h"
#include "ssym.h"
#include "sfpnum.h"
#include <string.h>
#include <stdlib.h>		// for atoi, atof
#include <ctype.h>		// for isdigit

#ifndef	FALSE
#define	FALSE	(0)
#define	TRUE	(1)
#endif



int equal(SExp s1, SExp s2) {
	if (eq(s1, s2)) {
		return TRUE;
	} else {
		SType t1 = type_of(s1);
		SType t2 = type_of(s2);
		if (t1 == t2) {
			switch (t1) {
			default:	break;
			case tString:	return strcmp(s1.ptr->string.str, s2.ptr->string.str) == 0;
			case tCell:		return equal(car(s1), car(s2)) && equal(cdr(s1), cdr(s2));
			}
		}
	}
	return FALSE;
}

#include "seval.h"
SExp list1(SExp c1) {
	push_stack(c1);
	push_stack(nil);
	cons_on_stack_rev();
	return pop_stack(1);
}

SExp list2(SExp c1, SExp c2) {
	push_stack(c1);
	push_stack(c2);
	push_stack(nil);
	cons_on_stack_rev();
	cons_on_stack_rev();
	return pop_stack(1);
}

SExp list3(SExp c1, SExp c2, SExp c3) {
	push_stack(c1);
	push_stack(c2);
	push_stack(c3);
	push_stack(nil);
	cons_on_stack_rev();
	cons_on_stack_rev();
	cons_on_stack_rev();
	return pop_stack(1);
}

SExp copy_list(SExp s) {
	push_stack(nil);
	for (; consp(s); s = cdr(s)) {
		SExp a = car(s);
		push_stack(a);
		cons_on_stack();
	}
	{
		SExp l = pop_stack(1);
		SExp r = nreverse(l);
		if (!nilp(s)) {
			rplacd(l, s);
		}
		return r;
	}
}

int list_length(SExp s) {
	/*
		@todo:
			return nil when list is looped (in Common Lisp)
	*/
	int n;
	for (n=0; consp(s); s = cdr(s), ++n)
		;
	return n;
}

SExp last1(SExp s) {
	if (consp(s)) {
		SExp n;
		for (; n = cdr(s), consp(n); s = n)
			;
	}
	return s;
}

SExp nreverse(SExp s) {
	SExp prev = nil;
	for (; consp(s); ) {
		SExp next = cdr(s);
		rplacd(s, prev);
		prev = s;
		s = next;
	}
	return prev;
}

SExp nconc2(SExp s, SExp r) {
	if (nilp(s)) {
		return r;
	} else {
		SExp sl = last1(s);
		rplacd(sl, r);
		return s;
	}
}

SExp assoc(SExp key, SExp ls) {
	for (; consp(ls); ls = cdr(ls)) {
		SExp a = car(ls);
		if (eq(car(a), key)) {
			return a;
		}
	}
	return nil;
}

SExp member(SExp s, SExp ls) {
	for (; consp(ls); ls = cdr(ls)) {
		SExp r = car(ls);
		if (eq(r, s)) {
			return ls;
		}
	}
	return nil;
}


SExp mapcar1(SExp (*fn)(SExp, void*), SExp ls, void* param) {
	push_stack(nil);
	for (; !nilp(ls); ls = cdr(ls)) {
		SExp v = fn(car(ls), param);
		push_stack(v);
		cons_on_stack();
	}
	return pop_nrev_stack();
}


SExp array2s(SExp* tbl, int n) {
	int i;
	push_stack(nil);
	for (i=0; i<n; ++i) {
		push_stack(tbl[i]);
		cons_on_stack();
	}
	return pop_nrev_stack();
}



/// Return number if string is number literal
/**
	@return		nil for not number

	see http://www.lispworks.com/documentation/HyperSpec/Body/02_ca.htm#syntaxfornumerictokens

	1.
	.1
	1e1 = 10.0
 */
SExp make_number(const char* str) {
	// parse int num
	const unsigned char* p = str;
	int flag = +1;
	int intpart = FALSE;
	int c;
	if (*p == '+') {
		++p;
	} else if (*p == '-') {
		flag = -1;
		++p;
	}
	if (*p == '\0')	return nil;

	for (; (c = *p++) != '\0'; ) {
		if (!isdigit(c))	goto L_check_fp;
		intpart = TRUE;
	}
	return fixnum2s(atoi(str));

L_check_fp:
	// parse float num
	{
		int fracpart = FALSE, dot = FALSE;
		if (c == '.') {
			dot = TRUE;
			for (; (c = *p++) != '\0'; ) {
				if (!isdigit(c))	break;
				fracpart = TRUE;
			}
		}
		if (intpart || fracpart) {
			switch (c) {
			case '\0':
				if (!dot) {
					return fixnum2s(atoi(str));
				} else {
					return gen_fpnum(atof(str));
				}
				break;
			case 'e': case 'E':
				{
					int exppart = FALSE;
					int expflag = +1;
					if (*p == '+') {
						++p;
					} else if (*p == '-') {
						flag = -1;
						++p;
					}
					for (; (c = *p++) != '\0'; ) {
						if (!isdigit(c))	return nil;
						exppart = TRUE;
					}
					if (exppart) {
						return gen_fpnum(atof(str));
					}
				}
				break;
			}
		}
	}
	return nil;
}


#include "sstream.h"
void format(SExp ostrm, const char* fmt, va_list* pap, ...) {
	const char* p;
	char buf[256];
	char* q = buf;
	va_list ap;
	if (pap == NULL) {
		va_start(ap, pap);
		pap = &ap;
	}
	for (p = fmt; *p != '\0'; ++p) {
		if (*p != '~') {
			*q++ = *p;
		} else {
			if (q != buf)	{ *q = '\0'; write_cstr(buf, ostrm); q = buf; }
			switch (*(++p)) {
			default:
				break;
			case 'a':
				{
					SExp s = va_arg(*pap, SExp);
					write(s, ostrm, FALSE);
				}
				break;
			case 's':
				{
					SExp s = va_arg(*pap, SExp);
					write(s, ostrm, TRUE);
				}
				break;
			case 'd':
				{
					SExp s = va_arg(*pap, SExp);
					s = type_check(s, tFixnum);
					write(s, ostrm, TRUE);
				}
				break;
			case '%':
				*q++ = '\n';
				break;
			}
		}
	}
	if (q != buf)	{ *q = '\0'; write_cstr(buf, ostrm); q = buf; }
	va_end(*pap);
}




// FNV Hash
// http://www.isthe.com/chongo/tech/comp/fnv/
#define	FNV1_32A_INIT	0x811c9dc5
#define	FNV_32_PRIME	0x01000193

unsigned int strhash(const char* str) {
	unsigned int v = FNV1_32A_INIT;
	unsigned char c;
	while ((c = *str++) != '\0') {
		v = (v ^ c) * FNV_32_PRIME;
	}
	return v;
}

